home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / CLIPP52 / TCBLLIB2.ZIP / ERRORSYS.PRG < prev    next >
Text File  |  1993-09-21  |  4KB  |  214 lines
  1. /***
  2. *
  3. *    Errorsys.prg
  4. *
  5. *  Standard Clipper error handler
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. *  Compile:  /m /n /w
  11. *
  12. */
  13.  
  14. #include "llibg.ch"          // -LLIBG- Use Light Lib Graphics defines
  15. #include "llibgtoo.ch"       //         Use Light Lib Graphics tools defines
  16.  
  17. #include "error.ch"
  18.  
  19.  
  20. // put messages to STDERR
  21. #command ? <list,...>   =>  ?? Chr(13) + Chr(10) ; ?? <list>
  22. #command ?? <list,...>  =>  OutErr(<list>)
  23.  
  24.  
  25. // used below
  26. #define NTRIM(n)        ( LTrim(Str(n)) )
  27.  
  28.  
  29.  
  30. /***
  31. *    ErrorSys()
  32. *
  33. *    Note:  automatically executes at startup
  34. */
  35.  
  36. proc ErrorSys()
  37.     ErrorBlock( {|e| DefError(e)} )
  38. return
  39.  
  40.  
  41.  
  42.  
  43. /***
  44. *    DefError()
  45. */
  46. static func DefError(e)
  47. local i, cMessage, aOptions, nChoice
  48.  
  49.  
  50.  
  51.     // by default, division by zero yields zero
  52.     if ( e:genCode == EG_ZERODIV )
  53.         return (0)
  54.     end
  55.  
  56.  
  57.     // for network open error, set NETERR() and subsystem default
  58.     if ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )
  59.  
  60.         NetErr(.t.)
  61.         return (.f.)                                    // NOTE
  62.  
  63.     end
  64.  
  65.  
  66.     // for lock error during APPEND BLANK, set NETERR() and subsystem default
  67.     if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
  68.  
  69.         NetErr(.t.)
  70.         return (.f.)                                    // NOTE
  71.  
  72.     end
  73.  
  74.  
  75.  
  76.     // build error message
  77.     cMessage := ErrorMessage(e)
  78.  
  79.  
  80.     // build options array
  81.     // aOptions := {"Break", "Quit"}
  82.     aOptions := {"Quit"}
  83.  
  84.     if (e:canRetry)
  85.         AAdd(aOptions, "Retry")
  86.     end
  87.  
  88.     if (e:canDefault)
  89.         AAdd(aOptions, "Default")
  90.     end
  91.  
  92.  
  93.     // put up alert box
  94.     nChoice := 0
  95.     while ( nChoice == 0 )
  96.  
  97.         if ( Empty(e:osCode) )
  98.             nChoice := Alert( cMessage, aOptions )
  99.  
  100.         else
  101.             nChoice := Alert( cMessage + ;
  102.                             ";(DOS Error " + NTRIM(e:osCode) + ")", ;
  103.                             aOptions )
  104.         end
  105.  
  106.  
  107.         if ( nChoice == NIL )
  108.             exit
  109.         end
  110.  
  111.     end
  112.  
  113.  
  114.     if ( !Empty(nChoice) )
  115.  
  116.         // do as instructed
  117.         if ( aOptions[nChoice] == "Break" )
  118.             Break(e)
  119.  
  120.         elseif ( aOptions[nChoice] == "Retry" )
  121.             return (.t.)
  122.  
  123.         elseif ( aOptions[nChoice] == "Default" )
  124.             return (.f.)
  125.  
  126.         end
  127.  
  128.     end
  129.  
  130.     // display message and traceback
  131.     if ( !Empty(e:osCode) )
  132.         cMessage += " (DOS Error " + NTRIM(e:osCode) + ") "
  133.     end
  134.  
  135.                                 //-LLIBG- Light Lib Graphics
  136.                                 //        CLIPPER does not use the GT terminal
  137.                                 //        to QOUT() when in error mode !!!
  138.                                 //        So, if we are in a VGA or VESA mode,
  139.                                 //        just switch back to text mode
  140.                                 //        before to QOUT()
  141.    IF gMode()[LLG_MODE_IN_USE]<>LLG_VIDEO_TXT
  142.       gMode(LLG_VIDEO_TXT)
  143.    ENDIF
  144.  
  145.     ? cMessage
  146.     i := 2
  147.     while ( !Empty(ProcName(i)) )
  148.         ? "Called from", Trim(ProcName(i)) + ;
  149.             "(" + NTRIM(ProcLine(i)) + ")  "
  150.  
  151.         i++
  152.     end
  153.  
  154.    INKEY(0)                     //-LLIBG- Light Lib Graphics
  155.                                 //        When QUIT will execute, Light Lib Graphics
  156.                                 //        will restore the video mode used when the
  157.                                 //        application start. So it is important to
  158.                                 //        wait to allow user to read the error messages
  159.                                 //        before to restore previous video mode.
  160.     // give up
  161.     ErrorLevel(1)
  162.     QUIT
  163.  
  164. return (.f.)
  165.  
  166.  
  167.  
  168.  
  169. /***
  170. *    ErrorMessage()
  171. */
  172. static func ErrorMessage(e)
  173. local cMessage
  174.  
  175.  
  176.     // start error message
  177.     cMessage := if( e:severity > ES_WARNING, "Error ", "Warning " )
  178.  
  179.  
  180.     // add subsystem name if available
  181.     if ( ValType(e:subsystem) == "C" )
  182.         cMessage += e:subsystem()
  183.     else
  184.         cMessage += "???"
  185.     end
  186.  
  187.  
  188.     // add subsystem's error code if available
  189.     if ( ValType(e:subCode) == "N" )
  190.         cMessage += ("/" + NTRIM(e:subCode))
  191.     else
  192.         cMessage += "/???"
  193.     end
  194.  
  195.  
  196.     // add error description if available
  197.     if ( ValType(e:description) == "C" )
  198.         cMessage += ("  " + e:description)
  199.     end
  200.  
  201.  
  202.     // add either filename or operation
  203.     if ( !Empty(e:filename) )
  204.         cMessage += (": " + e:filename)
  205.  
  206.     elseif ( !Empty(e:operation) )
  207.         cMessage += (": " + e:operation)
  208.  
  209.     end
  210.  
  211.  
  212. return (cMessage)
  213.  
  214.